home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibcalc.arc / SCREENRO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-03-06  |  7.1 KB  |  142 lines
  1. (*----------------------------------------------------------------------*)
  2. (*    Color_Screen_Active --- Determine if color or mono screen         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Color_Screen_Active : BOOLEAN;
  6.  
  7. (*                                                                      *)
  8. (*     Function:   Color_Screen_Active                                  *)
  9. (*                                                                      *)
  10. (*     Purpose:    Determines if color or mono screen active            *)
  11. (*                                                                      *)
  12. (*     Calling Sequence:                                                *)
  13. (*                                                                      *)
  14. (*        Color_Active := Color_Screen_Active : BOOLEAN;                *)
  15. (*                                                                      *)
  16. (*           Color_Active --- set to TRUE if the color screen is        *)
  17. (*                            active, FALSE if the mono screen is       *)
  18. (*                            active.                                   *)
  19. (*                                                                      *)
  20. (*     Calls:   INTR                                                    *)
  21. (*                                                                      *)
  22.  
  23. VAR
  24.    Regs : RECORD       (* 8088 registers *)
  25.              Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags : INTEGER;
  26.           END;
  27.  
  28. BEGIN  (* Color_Screen_Active *)
  29.  
  30.    Regs.Ax := 15 SHL 8;
  31.  
  32.    INTR( $10 , Regs );
  33.  
  34.    Color_Screen_Active := ( Regs.Ax AND $FF ) <> 7;
  35.  
  36. END    (* Color_Screen_Active *);
  37.  
  38. (*----------------------------------------------------------------------*)
  39. (*        Get_Screen_Address --- Get address of current screen          *)
  40. (*----------------------------------------------------------------------*)
  41.  
  42. PROCEDURE Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );
  43.  
  44. (*                                                                      *)
  45. (*     Procedure:  Get_Screen_Address                                   *)
  46. (*                                                                      *)
  47. (*     Purpose:    Gets screen address for current type of display      *)
  48. (*                                                                      *)
  49. (*     Calling Sequence:                                                *)
  50. (*                                                                      *)
  51. (*        Get_Screen_Address( VAR Actual_Screen : Screen_Ptr );         *)
  52. (*                                                                      *)
  53. (*           Actual_Screen --- pointer whose value receives the         *)
  54. (*                             current screen address.                  *)
  55. (*                                                                      *)
  56. (*     Calls:   Color_Screen_Active                                     *)
  57. (*              PTR                                                     *)
  58. (*                                                                      *)
  59.  
  60. BEGIN  (* Get_Screen_Address *)
  61.  
  62.    IF Color_Screen_Active THEN
  63.       Actual_Screen := PTR( Color_Screen_Address , 0 )
  64.    ELSE
  65.       Actual_Screen := PTR( Mono_Screen_Address , 0 );
  66.  
  67. END    (* Get_Screen_Address *);
  68.  
  69. (*----------------------------------------------------------------------*)
  70. (*                Set/Reset Text Color Routines                         *)
  71. (*----------------------------------------------------------------------*)
  72. (*                                                                      *)
  73. (*   These routines set and reset the global text foreground and        *)
  74. (*   background colors.                                                 *)
  75. (*                                                                      *)
  76. (*----------------------------------------------------------------------*)
  77.  
  78.                    (* Global Text Color Variables *)
  79.  
  80. VAR
  81.    Global_ForeGround_Color : INTEGER;
  82.    Global_BackGround_Color : INTEGER;
  83.  
  84. (*----------------------------------------------------------------------*)
  85. (*    Set_Global_Colors --- Reset global foreground, background cols.   *)
  86. (*----------------------------------------------------------------------*)
  87.  
  88. PROCEDURE Set_Global_Colors( ForeGround, BackGround : INTEGER );
  89.  
  90. (*                                                                      *)
  91. (*     Procedure:  Set_Global_Colors                                    *)
  92. (*                                                                      *)
  93. (*     Purpose:    Sets global text foreground, background colors.      *)
  94. (*                                                                      *)
  95. (*     Calling Sequence:                                                *)
  96. (*                                                                      *)
  97. (*        Set_Global_Colors( ForeGround, BackGround : INTEGER );        *)
  98. (*                                                                      *)
  99. (*           ForeGround --- Default foreground color                    *)
  100. (*           BackGround --- Default background color                    *)
  101. (*                                                                      *)
  102. (*     Calls:   TextColor                                               *)
  103. (*              TextBackGround                                          *)
  104. (*                                                                      *)
  105.  
  106. BEGIN  (* Set_Global_Colors *)
  107.  
  108.    Global_ForeGround_Color := ForeGround;
  109.    GLobal_BackGround_Color := BackGround;
  110.  
  111.    TextColor     ( Global_ForeGround_Color );
  112.    TextBackground( Global_BackGround_Color );
  113.  
  114. END    (* Set_Global_Colors *);
  115.  
  116. (*----------------------------------------------------------------------*)
  117. (*  Reset_Global_Colors --- Reset global foreground, background cols.   *)
  118. (*----------------------------------------------------------------------*)
  119.  
  120. PROCEDURE Reset_Global_Colors;
  121.  
  122. (*                                                                      *)
  123. (*     Procedure:  Reset_Global_Colors                                  *)
  124. (*                                                                      *)
  125. (*     Purpose:    Resets text foreground, background colors to global  *)
  126. (*                 defaults.                                            *)
  127. (*                                                                      *)
  128. (*     Calling Sequence:                                                *)
  129. (*                                                                      *)
  130. (*        Reset_Global_Colors;                                          *)
  131. (*                                                                      *)
  132. (*     Calls:   TextColor                                               *)
  133. (*              TextBackGround                                          *)
  134. (*                                                                      *)
  135.  
  136. BEGIN  (* Reset_Global_Colors *)
  137.  
  138.    TextColor     ( Global_ForeGround_Color );
  139.    TextBackground( Global_BackGround_Color );
  140.  
  141. END    (* Reset_Global_Colors *);
  142.